home *** CD-ROM | disk | FTP | other *** search
/ Gekkan Dennou Club 147 / Gekkan Dennou Club - 2000.8 Vol. 147 (Japan).7z / Gekkan Dennou Club - 2000.8 Vol. 147 (Japan) (Track 1).bin / docs / perl / monhash.pl < prev    next >
Perl Script  |  2000-06-25  |  1KB  |  74 lines
  1. # ハッシュの監視
  2. package MonHash;
  3.  
  4. sub TIEHASH {
  5.     my ($pkg, $name, $rh) = @_;
  6.     my $obj = {
  7.     name => $name, hash => {%$rh},
  8.     };
  9.     bless $obj, $pkg;
  10.     $obj;
  11. }
  12.  
  13. sub FETCH {
  14.     my ($obj, $index) = @_;
  15.     my $value = $obj->{'hash'}->{$index};
  16.     print 'Read : $', $obj->{'name'}, "{$index} -> $value\n";
  17.     $value;
  18. }
  19.  
  20. sub STORE {
  21.     my ($obj, $index, $new_value) = @_;
  22.     print 'Write : $', $obj->{'name'}, "{$index} <- $new_value\n";
  23.     $obj->{'hash'}->{$index} = $new_value;
  24. }
  25.  
  26. sub CLEAR {
  27.     my $obj = shift;
  28.     print 'Clear : %', "$obj->{'name'}\n";
  29.     $obj->{'hash'} = {};
  30. }
  31.  
  32. sub DESTROY {
  33.     my $obj = shift;
  34.     if( $obj->{'name'} ne '__UNMONITOR__' ){
  35.     print 'DESTORY %', "$obj->{'name'}\n";
  36.     }
  37. }
  38.  
  39. sub unmonitor {
  40.     my ($pkg, $rvar) = @_;
  41.     my $last_hash;
  42.     {
  43.     my $obj = tied %$rvar;
  44.     $last_hash = $obj->{'hash'};
  45.     $obj->{'name'} = '__UNMONITOR__'
  46.     }
  47.     untie %$rvar;
  48.     %$rvar = %$last_hash;
  49. }
  50.  
  51. package main;
  52.  
  53. %h = (a => 10, b => 20, c => 30);
  54.  
  55. print %h, "\n";
  56.  
  57. tie %h, 'MonHash', 'h', \%h;
  58.  
  59. $x = $h{'b'};
  60. print "x = $x\n";
  61.  
  62. $h{'b'} = 200;
  63.  
  64. $y = $h{'b'};
  65. print "y = $y\n";
  66.  
  67. %h = ( a => 100, b => 200, c => 300 );
  68.  
  69. MonHash->unmonitor( \%h );
  70.  
  71. print %h;
  72.  
  73. # end of file
  74.